perm filename CODE4.OL2[P11,LCS] blob
sn#579535 filedate 1981-04-14 generic text, type T, neo UTF8
00100 C****** CODE4.F4 DRAWS LINES, DASHES, ETC. *******
00200 C TITLE ITMSUB
00300 C INTERNAL ITMSUB
00400 C EXTERNAL BM,NOZERO,LINX,ROFF,CENTX,STF,LINES,.COMM.
00500 C EXTERNAL DAT,RHORZ,CLEFS,PLTR,MIN,POSI,ALF,RDRAW,OLDTOP
00600 C DEFINE R9 <.COMM.+=10 >↔ DEFINE R8<.COMM.+=9 >
00700 C DEFINE J2 <.COMM.+3 >↔ DEFINE J10 <.COMM.+=31 >
00800 C DEFINE J7 <.COMM.+=28 >
00900 SUBROUTINE ITMSUB
01000 IMPLICIT INTEGER(A-Q,S-Z)
01100 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1,XDIS,OLDY
01200 COMMON/STF/RSTFAC(0/7),RSTJ2/MIN/MINI,RMINI
01300 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,RG,RH/BM/RA,RC,RJY
01400 COMMON/POSI/STFF(0/7),JJ2,POS/PLTR/PLT,RHT,DIS,XDIS
01500 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01600 1 RJA,YY,DISX,HGT,RZ,INP(53) /OLDTOP/OLDY
01800 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(R11,
01900 1RJQ(9)),(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
02000 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
02100 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
02200 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
02300 1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
02400 C RDBR IS SPACER FOR DBL BAR.
02500 RST7=RSTJ2*7.
02600 RST18=RSTJ2*18.
02700 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02800 R3Q=R3
02900 C NEXT DRAWS STRAIGHT LINES
03000 RD=R4*RST7
03100 RA=0
03200 RX=RTF*RSTJ2+POS
03300 J10=J10*DIS*RSTJ2
03400 C THICKNESS DEPENDS ON FINAL SIZE FACTOR (DIS) AND STAFF SIZE.(???!!)
03500 IF(J5.NE.50.AND.J5.NE.150)GO TO 300
03600 C 150 IS FOR 'PARTS' FEATURE - PUTS CRESC. IN ALL.
03700 CALL CRESC
03800 RETURN
03900 300 IF(R6.NE.0)GO TO 401
04000 IF(J7.NE.0)GO TO 401
04100 C FOR BAR LINES
04200 JA=44
04300 C CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
04400 C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
04500 DBR=0
04600 IF(J4.LT.1000)GO TO 400
04700 C J4=1001 = DBL BAR, =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
04800 DBR=J4/1000
04900 IF(J5.NE.0)GO TO 1
05000 IF(DBR.LT.2)GO TO 1
05100 J5=1
05200 IF(DBR.EQ.4)DBR=1
05300 C FOR REPEAT DBL.BAR WITH P5=0
05400 C P4=2000=DOTS ON RIGHT, =3000=BOTH SIDES
05500 C =4000=DOTS ON LEFT
05600
05700 1 J4=J4-DBR*1000
05800 C DBR=1 HEAVY BAR IS ON R
05900 9400 RD=RDBR+RDBR*RSTJ2
06000 C TO SPACE THIN BAR FROM HEAVY
06100 IF(J5.EQ.0)GO TO 400
06200 C NEXT ADDS REPEAT DOTS TO DBL BAR.
06300 CALL RPDOT
09900 GO TO 5400
10000 400 IF(J5.NE.0)GO TO 9400
10100 K=J4/100
10200 C K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
10300 J7=K*DIS
10400 C J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
10500 C5400 L=MOD(J4,100)
10600 C IF(J4.LT.0)J4=0
10700 C ABOVE FOR INVIS. BARS (AT PRINT TIME)
10800 5400 L=J4
10900 IF(L.LT.0)L=0
11000 L=MOD(L,100)
11100 IF(L.NE.0)L=L-1
11200 L=L+J2
11300 C L=L+J2-1
11400 C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
11500 RA=RTF
11600 IF(L.LE.7)GO TO 2400
11700 L=7
11800 RA=300.
11900 C FOR EXTENDING BARS ABOVE STAFF 7
12000 2400 OLDY=RSTFAC(L)
12100 C SAVE IT FOR DBL RPT BAR.
12200 RZ=R3Q
12300 OLDY=STFF(L)+(RA+56.)*OLDY
12400 1400 RA=1
12500 IF(PLT.GE.0)GO TO 140
12600 IF(J4.LT.0)RETURN
12700 J7=J7+1
12800 C DON'T PRINT INVIS BARS. (USED BY 'PAGE')
12900 RA=XDIS
13000 C BAR LINES PLOT AS DOUBLE THICKNESS
13100 140 RJX=R3Q
13200 42 CALL LINES(R3Q,RX,3)
13300 RJ=-1.
13400 RW=OLDY
13500 406 CALL LINES(RJX,OLDY,2)
13600 IF(J10.EQ.0)GO TO 411
13700 C P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
13800 J7=J10
13900 J10=0
14000 RA=XDIS
14100 411 IF(J7.LE.0)GO TO 409
14200 CALL HEAVY
14300 GO TO 42
14400 409 IF(DBR.LE.0)RETURN
14500 OLDY=RW
14600 RA=RZ-RD
14700 IF(DBR.NE.1)RA=RJX+RD-1.
14800 R3Q=RA
14900 DBR=DBR-2
15000 GO TO 1400
15100
15200 402 RJX=RJX+RA
15300 C HEAVIER BAR LINES
15400 CALL LINES(RJX,OLDY,2)
15500 J7=J7-1
15600 OLDY=RW
15700 IF(RJ.LT.0)OLDY=RX
15800 RJ=-RJ
15900 GO TO 406
16000 C DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
16100 1401 CALL HBRACK
16200 GO TO 2401
16300 C DASHES
16400 401 POS=POS-RST18
16500 IF(J7.LE.0)GO TO 407
16600 IF(J7.EQ.4)GO TO 1401
16700 IF(J7.NE.3)GO TO 4001
16800 C NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
16900 2401 JA=3
17000 IF(J10.EQ.0)J10=6.*DIS*RSTJ2
17100 C THICKNESS FOLLOWS PLOTTER SIZE AND STAFF SIZE
17200 C DEFAULT VALUE FOR THICKNESS =6*SIZE FACTS.
17300 R4=R4-RBR
17400 J9=0
17500 J5=35
17600 C THE NUM FOR THE LITTLE END ITEMS
17700 R6=3
17800 R7=0
17900 C DOES LOWER ONE FIRST. ITEM IS IN 'CLEFC.DMD' ON DAT.LCS
18000 R8=0
18100 C R8 MUST BE 0 FOR CLEFS (ELSE IT ACTIVATES THICKENER)
18200 JZ8=J8
18300 C SAVE J8 IN JZ8 (J8 WIPED OUT IN CLEFS)
18400 IF(J8.NE.2)CALL CLEFS
18500 C P8=1=BOTTOM 1/2 BRACK. ONLY: =2=TOP 1/2 ONLY: 0=COMPLETE
18600 R4=R5-RBR
18700 R6=3
18800 R7=-3
18900 C TURNS IT UPSIDE DOWN.
19000 IF(J7.NE.4)GO TO 3401
19100 POS=RA
19200 R4=R4*RJY/RSTJ2
19300 C TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
19400 3401 IF(JZ8.NE.1)CALL CLEFS
19500 C JZ8 IS CURRENTLY J8 (INTEGER I.E.)
19600 R3Q=R3Q-12.0*RSTJ2
19700 IF(J7.NE.4)GO TO 407
19800 J7=0
19900 GO TO 140
20000 4001 IF(J7.NE.5)GO TO 4002
20100 CALL CBRACK
20200 RETURN
20300 4002 IF(R8.LE.0)R8=.8
20400 C NO NEG. NUMBS!!!! 2/78
20500 C P8 CAN SET SIZE OF DASH
20600 RZ=5.96*RSTJ2
20700 RJ=R8*RZ
20800 RZ=R9*RZ
20900 IF(R9.LE.0)RZ=RJ
21000 C P9 SETS SPACE BETWEEN DASHES. (CAN BE DIFFERENT FROM P8)
21100 R8=RJ
21200 R9=RZ
21300 RD=RD+POS
21400 RJX=RD
21500 RJY=RD
21600 C =1 =DASHES, P6=P3=VERTICAL; P4=P5=HORIZ.; OTHERWISE SLOPE.
21700 J6=ROFF(RHORZ(R6))
21800 J3=J6-J3
21900 RJ4=R5-R4
22000 RA=J6
22100 C SAVE FOR THICK LINES
22200 C RA IS HORIZ. GOAL FOR DASHES
22300 OLDY=POS+R5*RST7
22400 IF(J4.EQ.0)GO TO 41
22500 RH=OLDY-RD
22600 C TOTAL HEIGHT DIFF.
22700 RX=RA-R3
22800 C TOTAL LENGTH DIFF.
22900 RH=RH/RX
23000 41 L=3
23100 K=2
23200 416 CALL LINES(R3Q,RD,L)
23300 IF(J3.EQ.0)GO TO 412
23400 C JUMP FOR VERT. DASH
23500 IF(J3.GT.0)GO TO 422
23600 IF(R3Q.LE.RA)GO TO 413
23700 C THIS IF P6 IS LESS THAN P3
23800 R3Q=R3Q-RJ
23900 GO TO 423
24000 422 IF(R3Q.GE.RA)GO TO 413
24100 C JUMP IF ALL DONE
24200 R3Q=R3Q+RJ
24300 423 IF(J4.NE.0)RD=RJY+RH*(R3Q-R3)
24400 C J4 HAS TILT(SEE I402 -)
24500 C FINDS HEIGHT OF RIGHT SIDE OF SLOPE
24600 414 CALL EXCH(L,K)
24700 CALL EXCH(RJ,RZ)
24800 C EXCH. SPACE AND DASH SIZE.
24900 GO TO 416
25000 412 IF(J4.GT.0)GO TO 424
25100 IF(RD.LE.OLDY)GO TO 413
25200 RD=RD-RJ
25300 C THIS IF P5 IS LESS THAN P4.
25400 GO TO 414
25500 424 IF(RD.GE.OLDY)GO TO 413
25600 C JUMP IF DONE
25700 RD=RD+RJ
25800 GO TO 414
25900 413 IF(J10.GT.0)GO TO 420
26000 IF(J11.EQ.0)RETURN
26100 IF(J3)RJ=-RJ
26200 IF(L.EQ.3)R3Q=R3Q-RJ
26300 RX=R8
26400 IF(J11.LT.0)RX=-RX
26500 CALL LINX(R3Q,RD,R3Q,RD+RX)
26600 C PUTS BRACK END ON DASHED LINE. (P11=1 OR -1)
26700 RETURN
26800 C NEXT FOR THICK DASHES
26900 420 J10=J10-1
27000 RJ=XDIS
27100 IF(J3.EQ.0)GO TO 415
27200 R3Q=R3
27300 RJY=RJY+RJ
27400 RD=RJY
27500 GO TO 417
27600 415 R3Q=R3Q+RJ
27700 RD=RJX
27800 417 RJ=R8
27900 RZ=R9
28000 C FOR THICK DASHES.
28100 GO TO 41
28200 407 RX=RD+POS
28300 OLDY=R5*RST7+POS
28400 R8=ABS(R8)
28500 C NO NEG, TOLERATED!!! 2/78
28600 IF(J7.EQ.3)GO TO 140
28700 CALL NOZERO(R9)
28800 IF(J7.EQ.-1)GO TO 408
28900 C FOR 'TR' J7=-2, 'ARPEGG' J7=-1, STRAIGHT LINES J7=0
29000 RJX=IFIX(ROFF(RHORZ(R6)))
29100 C ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
29200 IF(J7.EQ.0)GO TO 42
29300 OLDY=R9*RST7+RX
29400 CALL NOZERO(R8)
29500 4041 RZ=RX
29600 RH=OLDY
29700 C SAVE FOR THICK WIGGLES
29800 CALL LINES(R3Q,RX,3)
29900 C DRAWS STRAIGHT LINES. ETC.
30000 R9=R3Q
30100 RJ=OLDY
30200 RW=3.*RSTJ2*R8
30300 RA=RW*2.5
30400 C P8=HORZ. WIGGLE SIZE; P9=VERT. SIZE
30500 404 R9=R9+RA
30600 CALL LINES(R9,RJ,2)
30700 R9=R9+RW
30800 CALL LINES(R9,RJ,2)
30900 405 CALL EXCH(RX,RJ)
31000 IF(R9.LT.RJX)GO TO 404
31100 IF(J10.LE.0)RETURN
31200 OLDY=XDIS
31300 RX=RZ+OLDY
31400 OLDY=RH+OLDY
31500 J10=J10-1
31600 GO TO 4041
31700 C P10= + NUM OF THICKNESSES TO WIGGLE
31800 408 IF(RX.GT.OLDY)CALL EXCH(RX,OLDY)
31900 RZ=R9*RSTJ2*5.96
32000 C USE P9 TO SET WIGGLE WIDTH. P8 TO SET HGT.
32100 CALL NOZERO(R8)
32200 RD=R8*RST7*.5
32300 RJ=RD
32400 IF(RD.LT.1.)RD=1.
32500 421 R9=RX
32600 RW=R3Q
32700 RA=RZ+R3Q
32800 CALL LINES(RW,R9,3)
32900 410 R9=R9+RJ
33000 CALL LINES(RA,R9,2)
33100 R9=R9+RD
33200 CALL LINES(RA,R9,2)
33300 CALL EXCH(RA,RW)
33400 IF(R9.LT.OLDY)GO TO 410
33500 IF(J10.LE.0)RETURN
33600 R3Q=R3Q+XDIS
33700 J10=J10-1
33800 GO TO 421
33900 C VERTICAL WIGGLE P10=+ NUM OF THICKNESSES.
34000 END